home *** CD-ROM | disk | FTP | other *** search
/ Amiga Games: Greatest Hits 1996 / Amiga Games: Greatest Hits 1996.iso / spiele / publicdomain / ls-tron3.1 / ls-tron.mod < prev    next >
Text File  |  1996-04-14  |  24KB  |  891 lines
  1. EXTERNAL;
  2.  
  3. { LS-Tron.mod }
  4.  
  5. CONST hex : ARRAY[0..15] OF STRING = ("0","1","2","3","4","5","6","7",
  6.                                       "8","9","a","b","c","d","e","f");
  7.  
  8.       Schraegstrich = "/";
  9.  
  10. {$I "include:exec/libraries.i"               }
  11. {$I "include:exec/memory.i"                  }
  12. {$I "include:libraries/dosextens.i"          }
  13. {$I "include:utils/random.i"                 }
  14. {$I "include:libraries/medplayer.i"          }
  15. {$I "include:graphics/Text.i"                }
  16. {$I "include:libraries/diskfont.i"           }
  17. {$I "include:Intuition/Intuition.i"          }
  18. {$I "include:Libraries/ReqTools.i"           }
  19. {$I "include:Utils/StringLib.i"              }
  20. {$I "include:Graphics/Graphics.i"            }
  21. {$I "include:Graphics/Pens.i"                }
  22. {$I "include:Utils/Parameters.i"             }
  23.  
  24.  
  25. PROCEDURE FileRequest(Titel,dir,datei : STRING);
  26.  
  27.   VAR dummy   : STRING;
  28.       filer   : RTFileRequesterPtr;
  29.       MeinTag : ReqTagListPtr;
  30.       xyz     : INTEGER;
  31.  
  32.   BEGIN
  33.     New(MeinTag);
  34.     dummy:=AllocString(255);
  35.     strcpy(datei,"");
  36.  
  37.     filer:=NIL;
  38.     filer:=ADDRESS(rtAllocRequestA(rt_FileReq,NIL));
  39.  
  40.     If Filer<>NIL THEN
  41.        BEGIN
  42.          MeinTag^[0].ti_Tag:=RTFI_DIR;
  43.          MeinTag^[0].ti_Data:=INTEGER(Dir);
  44.          MeinTag^[1].ti_Tag:=Tag_End;
  45.          xyz:=RTChangeReqAttrA(ADDRESS(filer),MeinTag);
  46.  
  47.          xyz:=rtFileRequestA(filer,datei,Titel,NIL);
  48.          IF xyz<>0 THEN BEGIN
  49.                           StrCpy(dir,Filer^.Dir);
  50.  
  51.                           StrCpy(dummy,datei);
  52.                           StrCpy(datei,filer^.Dir);
  53.                           IF (datei[StrLen(datei)-1]<>Schraegstrich[0]) AND
  54.                              (StrLen(datei)>0) THEN
  55.                              StrCat(datei,"/");
  56.                           StrCat(datei,dummy);
  57.                         END
  58.                    ELSE StrCpy(datei,"");
  59.        END;
  60.     xyz:=rtFreeRequest(filer);
  61.     Dispose(MeinTag);
  62.     FreeString(dummy);
  63.   END;
  64.  
  65. PROCEDURE Show(Meldung : STRING);
  66.  
  67.   VAR Code : INTEGER;
  68.  
  69.   BEGIN
  70.     Code:=rtEZRequestA(meldung,"Ok",NIL,NIL,NIL);
  71.   END;
  72.  
  73. FUNCTION Ask(Meldung : STRING) : BOOLEAN;   { Requester aufrufen   }
  74.  
  75.   VAR Code : INTEGER;
  76.  
  77.   BEGIN
  78.     Code:=rtEZRequestA(meldung,"Ja!Ja!|NEIN!",NIL,NIL,NIL);
  79.     ask:=code<>0;
  80.   END;
  81.  
  82. FUNCTION AskEnglish(Meldung : STRING) : BOOLEAN;   { Requester aufrufen   }
  83.  
  84.   VAR Code : INTEGER;
  85.  
  86.   BEGIN
  87.     Code:=rtEZRequestA(meldung,"Yes!|No!",NIL,NIL,NIL);
  88.     askEnglish:=code<>0;
  89.   END;
  90.  
  91. FUNCTION Choose(meldung,wahl1,wahl2,wahl3 : STRING) : BYTE;
  92.  
  93.   VAR s : STRING;
  94.  
  95.   BEGIN
  96.     s:=ALLOCSTRING(255);
  97.  
  98.     strcpy(s,wahl1);
  99.     strcat(s,"|");
  100.     strCat(s,wahl2);
  101.     strcat(s,"|");
  102.     strCat(s,Wahl3);
  103.  
  104.     Choose:=rtEZRequestA(meldung,s,NIL,NIL,NIL);
  105.  
  106.     FreeString(s);
  107.   END;
  108.  
  109. PROCEDURE MakeString(myVar : INTEGER;VAR s : STRING); { Integer => String }
  110.  
  111.   VAR x : SHORT;
  112.  
  113.   BEGIN
  114.     x:=IntToStr(s,MyVar);
  115.   END;
  116.  
  117. PROCEDURE AddString(VAR s : STRING;x : SHORT); { Integer an String hängen }
  118.  
  119.   VAR help : STRING;
  120.  
  121.   BEGIN
  122.     help:=AllocString(20);
  123.     makeString(x,help);
  124.     StrCat(s,help);
  125.     FreeString(help);
  126.   END;
  127.  
  128. FUNCTION IncAddress(x : ADDRESS;zahl : INTEGER) : ADDRESS;
  129.  
  130.   BEGIN
  131.     IncAddress:=ADDRESS(INTEGER(x)+zahl);
  132.   END;
  133.  
  134. FUNCTION Str2Int(s : STRING) : INTEGER;
  135.  
  136.   VAR vorzeichen : BOOLEAN;
  137.       zaehler    : INTEGER;
  138.       zahl       : INTEGER;
  139.  
  140.   BEGIN
  141.     Vorzeichen:=(StrNEq(s,"+",1) OR StrNEq(s,"-",1));
  142.  
  143.     IF vorzeichen THEN zaehler:=1
  144.                   ELSE zaehler:=0;
  145.     zahl:=0;
  146.  
  147.     WHILE (zaehler<StrLen(s)) DO
  148.       BEGIN
  149.         zahl:=zahl*10+ORD(s[zaehler])-48;
  150.         inc(zaehler);
  151.       END;
  152.  
  153.     IF Vorzeichen THEN
  154.        IF StrNEq(s,"-",1) THEN zahl:=-zahl;
  155.  
  156.     Str2Int:=zahl;
  157.   END;
  158.  
  159. PROCEDURE Byte2Hex(zahl : BYTE;VAR s : STRING);
  160.  
  161.   VAR upper : BYTE;
  162.  
  163.   BEGIN
  164.     upper:=zahl SHR 4;
  165.     zahl:=zahl AND $0f;
  166.  
  167.     StrCpy(s,"$");
  168.     StrCat(s,Hex[upper]);
  169.     StrCat(s,Hex[zahl]);
  170.   END;
  171.  
  172. PROCEDURE Code2String(zahl : BYTE;VAR s : STRING);
  173.  
  174.   CONST zeichen = "`1234567890ß`\\  QWERTZUIOPÜ+    ASDFGHJKLÖÄ#    <YXCVBNM,.-";
  175.  
  176.   BEGIN
  177.     zahl:=zahl AND $7f;
  178.  
  179.     IF ((zahl>= 0) AND (zahl<=13)) OR
  180.        ((zahl>=16) AND (zahl<=27)) OR
  181.        ((zahl>=32) AND (zahl<=43)) OR
  182.        ((zahl>=48) AND (zahl<=58)) THEN
  183.        BEGIN
  184.          s[0]:=zeichen[zahl];
  185.          s[1]:=CHR(0);
  186.        END
  187.       ELSE IF (zahl>=80) AND (zahl<=89) THEN
  188.               BEGIN
  189.                 StrCpy(s,"F");
  190.                 Addstring(s,zahl-79);
  191.               END
  192.              ELSE
  193.               CASE zahl OF
  194.                $1d : StrCpy(s,"(1)"); { Zahlen im Nummernblock }
  195.                $1e : StrCpy(s,"(2)");
  196.                $1f : StrCpy(s,"(3)");
  197.                $2d : StrCpy(s,"(4)");
  198.                $2e : StrCpy(s,"(5)");
  199.                $2f : StrCpy(s,"(6)");
  200.                $3d : StrCpy(s,"(7)");
  201.                $3e : StrCpy(s,"(8)");
  202.                $3f : StrCpy(s,"(9)");
  203.  
  204.                 60 : StrCpy(s,"(.)");
  205.                 64 : StrCpy(s,"Space");
  206.                 65 : StrCpy(s,"Backspace");
  207.                 66 : StrCpy(s,"Tab");
  208.                 67 : StrCpy(s,"Enter");
  209.                 68 : StrCpy(s,"Return");
  210.                 69 : StrCpy(s,"Escape");
  211.                 70 : StrCpy(s,"Delete");
  212.  
  213.                 74 : StrCpy(s,"(-)");
  214.  
  215.                 76 : StrCpy(s,"Cursor hoch");
  216.                 77 : StrCpy(s,"Cursor runter");
  217.                 78 : StrCpy(s,"Cursor rechts");
  218.                 79 : StrCpy(s,"Cursor links");
  219.                   { Funktionstasten }
  220.  
  221.                 90 : StrCpy(s,"([)");
  222.                 91 : StrCpy(s,"(])");
  223.                 92 : StrCpy(s,"(/)");
  224.                 93 : StrCpy(s,"(*)");
  225.                 94 : StrCpy(s,"(+)");
  226.                 95 : StrCpy(s,"Help");
  227.                 96 : StrCpy(s,"Shift links");
  228.                 97 : StrCpy(s,"Shift rechts");
  229.                 98 : StrCpy(s,"Caps Lock");
  230.                 99 : StrCpy(s,"Ctrl");
  231.                100 : StrCpy(s,"Alt links");
  232.                101 : StrCpy(s,"Alt rechts");
  233.                102 : StrCpy(s,"Amiga links");
  234.                103 : StrCpy(s,"Amiga rechts");
  235.                ELSE Byte2Hex(zahl,s);
  236.               END;
  237.   END;
  238.  
  239. PROCEDURE Code2StringEng(zahl : BYTE;VAR s : STRING);
  240.  
  241.   CONST zeichen = "`1234567890ß´\\  QWERTYUIOPÜ+    ASDFGHJKLÖÄ#    <ZXCVBNM,.-";
  242.  
  243.   BEGIN
  244.     zahl:=zahl AND $7f;
  245.  
  246.     IF ((zahl>= 0) AND (zahl<=13)) OR
  247.        ((zahl>=16) AND (zahl<=27)) OR
  248.        ((zahl>=32) AND (zahl<=43)) OR
  249.        ((zahl>=48) AND (zahl<=58)) THEN
  250.        BEGIN
  251.          s[0]:=zeichen[zahl];
  252.          s[1]:=CHR(0);
  253.        END
  254.       ELSE IF (zahl>=80) AND (zahl<=89) THEN
  255.               BEGIN
  256.                 StrCpy(s,"F");
  257.                 Addstring(s,zahl-79);
  258.               END
  259.              ELSE
  260.               CASE zahl OF
  261.                $1d : StrCpy(s,"(1)"); { Number on the numberblock }
  262.                $1e : StrCpy(s,"(2)");
  263.                $1f : StrCpy(s,"(3)");
  264.                $2d : StrCpy(s,"(4)");
  265.                $2e : StrCpy(s,"(5)");
  266.                $2f : StrCpy(s,"(6)");
  267.                $3d : StrCpy(s,"(7)");
  268.                $3e : StrCpy(s,"(8)");
  269.                $3f : StrCpy(s,"(9)");
  270.  
  271.                 60 : StrCpy(s,"(.)");
  272.                 64 : StrCpy(s,"Space");
  273.                 65 : StrCpy(s,"Backspace");
  274.                 66 : StrCpy(s,"Tab");
  275.                 67 : StrCpy(s,"Enter");
  276.                 68 : StrCpy(s,"Return");
  277.                 69 : StrCpy(s,"Escape");
  278.                 70 : StrCpy(s,"Delete");
  279.  
  280.                 74 : StrCpy(s,"(-)");
  281.  
  282.                 76 : StrCpy(s,"Cursor up");
  283.                 77 : StrCpy(s,"Cursor down");
  284.                 78 : StrCpy(s,"Cursor right");
  285.                 79 : StrCpy(s,"Cursor left");
  286.                   { Funktionstasten }
  287.  
  288.                 90 : StrCpy(s,"([)");
  289.                 91 : StrCpy(s,"(])");
  290.                 92 : StrCpy(s,"(/)");
  291.                 93 : StrCpy(s,"(*)");
  292.                 94 : StrCpy(s,"(+)");
  293.                 95 : StrCpy(s,"Help");
  294.                 96 : StrCpy(s,"Left Shift");
  295.                 97 : StrCpy(s,"Right Shift");
  296.                 98 : StrCpy(s,"Caps Lock");
  297.                 99 : StrCpy(s,"Ctrl");
  298.                100 : StrCpy(s,"Left Alt");
  299.                101 : StrCpy(s,"Right Alt");
  300.                102 : StrCpy(s,"Left Amiga");
  301.                103 : StrCpy(s,"Right Amiga");
  302.                ELSE Byte2Hex(zahl,s);
  303.               END;
  304.   END;
  305.  
  306. PROCEDURE SetGadget(Gad : GadgetPtr;nextGad,GadRender,SelRender,
  307.                                     GadText : ADDRESS);
  308.  
  309.   BEGIN
  310.     WITH Gad^ DO
  311.       BEGIN
  312.         NextGadget  :=nextGad;
  313.         GadgetRender:=GadRender;
  314.         SelectRender:=SelRender;
  315.         GadgetText  :=GadText;
  316.       END;
  317.   END;
  318.  
  319. PROCEDURE SelectGadget(rp : RastPortPtr;Gad : GadgetPtr);
  320.  
  321.   BEGIN
  322.     IF (Gad^.GadgetRender<>NIL) AND (Gad^.SelectRender<>NIL) THEN
  323.        WITH Gad^ DO
  324.          BEGIN
  325.            DrawBorder(RP,SelectRender,LeftEdge,TopEdge);
  326.            Delay(3);
  327.            DrawBorder(RP,GadgetRender,LeftEdge,TopEdge);
  328.          END;
  329.   END;
  330.  
  331. PROCEDURE Print(RP : RastPortPtr;x,y : SHORT;Zeile : STRING;colour : SHORT);
  332.  
  333.    { String ausgeben }
  334.  
  335.    BEGIN
  336.      SetAPen(RP,colour);
  337.      Move(RP,x,y);
  338.      GText(RP,Zeile,strLen(zeile));
  339.    END;
  340.  
  341. FUNCTION GetGadgetID(iadr : GadgetPtr) : SHORT; { Gadget identifizieren }
  342.  
  343.   BEGIN
  344.     GetGadgetID:=iadr^.GadgetID;
  345.   END;
  346.  
  347. PROCEDURE KillMSGs(UserPort : MsgPortPtr);
  348.  
  349.   VAR Msg : MessagePtr;
  350.  
  351.   BEGIN
  352.     Msg:=NIL;
  353.     Msg:=GetMsg(UserPort);
  354.     WHILE Msg<>NIL DO
  355.       BEGIN
  356.         ReplyMsg(Msg);
  357.         Msg:=NIL;
  358.         Msg:=GetMsg(UserPort);
  359.       END;
  360.   END;
  361.  
  362. PROCEDURE MyCloseWindow(MyWin : WindowPtr); { Fenster schön schließen }
  363.  
  364.   VAR Msg : MessagePtr;
  365.  
  366.   BEGIN
  367.     Msg:=NIL;
  368.     Msg:=GetMsg(MyWin^.UserPort);
  369.     WHILE Msg<>NIL DO
  370.       BEGIN
  371.         ReplyMsg(Msg);
  372.         Msg:=NIL;
  373.         Msg:=GetMsg(Mywin^.UserPort);
  374.       END;
  375.     CloseWindow(MyWin);
  376.   END;
  377.  
  378. PROCEDURE Line(RPort : RastPortPtr;x1,y1,x2,y2 : SHORT); { Linie Malen }
  379.  
  380.   BEGIN
  381.     Move(RPort,x1,y1);
  382.     Draw(RPort,x2,y2);
  383.   END;
  384.  
  385. PROCEDURE DrawBox(rp : RastportPtr;x,y,tx,ty : SHORT); { Box malen (3D) }
  386.  
  387.   BEGIN
  388.     SetAPen(RP,1);
  389.     Line(RP,  x,ty,  x, y);
  390.     Line(RP,  x, y, tx, y);
  391.  
  392.     SetAPen(RP,8);
  393.     Line(RP,  tx,y+1,  tx,ty);
  394.     Line(RP,tx-1, ty,   x,ty);
  395.   END;
  396.  
  397. PROCEDURE DrawIBox(rp : RastportPtr;x,y,tx,ty : SHORT); { Box invertiert }
  398.  
  399.   BEGIN
  400.     SetAPen(RP,8);
  401.     Line(RP,  x,ty,  x, y);
  402.     Line(RP,  x, y, tx, y);
  403.  
  404.     SetAPen(RP,1);
  405.     Line(RP,  tx,y+1,  tx,ty);
  406.     Line(RP,tx-1, ty,   x,ty);
  407.   END;
  408.  
  409. PROCEDURE DrawCBox(rp : RastportPtr;x,y,tx,ty,c1,c2 : SHORT); { Box mit Farbenwahl }
  410.  
  411.   BEGIN
  412.     SetAPen(RP,c1);
  413.     Line(RP,  x,ty,  x, y);
  414.     Line(RP,  x, y, tx, y);
  415.  
  416.     SetAPen(RP,c2);
  417.     Line(RP,  tx,y+1,  tx,ty);
  418.     Line(RP,tx-1, ty,   x,ty);
  419.   END;
  420.  
  421. PROCEDURE DrawSBox(rp : RastportPtr;x,y,tx,ty : SHORT); { einfarbige Box }
  422.  
  423.   BEGIN
  424.     SetAPen(RP,1);
  425.  
  426.     Move(RP, x, y);
  427.     Draw(RP, x,ty);
  428.     Draw(RP,tx,ty);
  429.     Draw(RP,tx, y);
  430.     Draw(RP, x, y);
  431.   END;
  432.  
  433. PROCEDURE Draw0Box(rp : RastportPtr;x,y,tx,ty : SHORT); { Box löschen }
  434.  
  435.   BEGIN
  436.     SetAPen(RP,0);
  437.  
  438.     Move(RP, x, y);
  439.     Draw(RP, x,ty);
  440.     Draw(RP,tx,ty);
  441.     Draw(RP,tx, y);
  442.     Draw(RP, x, y);
  443.   END;
  444.  
  445. FUNCTION Hoch(basis,exponent : INTEGER) : INTEGER;
  446.  
  447.   { Potenzieren ganzer Zahlen }
  448.  
  449.   VAR ergebnis,zaehler : INTEGER;
  450.  
  451.   BEGIN
  452.     ergebnis:=1;
  453.  
  454.     FOR Zaehler:=1 TO exponent DO ergebnis:=ergebnis*basis;
  455.  
  456.     Hoch:=ergebnis;
  457.   END;
  458.  
  459.  
  460. TYPE IFFTitles = (BMHD_f,CMAP_f,CAMG_f,BODY_f);
  461.  
  462.      BMHD = RECORD
  463.               width,
  464.               height      : SHORT;
  465.               depth       : BYTE;
  466.               left,
  467.               top         : SHORT;
  468.               masking     : BYTE;
  469.               transCol    : SHORT;
  470.               xAspect,
  471.               yAspect     : BYTE;
  472.               scrnWidth,
  473.               scrnHeight  : SHORT;
  474.             END;
  475.  
  476.      CMAP = RECORD
  477.               colorcnt    : SHORT;
  478.               red,
  479.               green,
  480.               blue        : ARRAY [0..255] OF BYTE;
  481.             END;
  482.  
  483.      CAMG = RECORD
  484.               viewType    : INTEGER;
  485.             END;
  486.  
  487.      IFFInfoType = RECORD
  488.                      IFFBMHD  : BMHD;
  489.                      IFFCMAP  : CMAP;
  490.                      IFFCAMG  : CAMG;
  491.                      IFFTitle : IFFTitles;
  492.                    END;
  493.  
  494.      IFFInfoTypePtr = ^IFFInfoType;
  495.  
  496.  
  497.       { IFFErrors }
  498.  
  499. CONST iffNoErr            = 0;
  500.       iffOutOfMem         = 1;
  501.       iffOpenScreenfailed = 2;
  502.       iffOpenWindowFailed = 3;
  503.       iffOpenFailed       = 4;
  504.       iffWrongIff         = 5;
  505.       iffReadWriteFailed  = 6;
  506.  
  507.       { IFFError-Strings }
  508.  
  509. CONST IFFErrorStrings : ARRAY [iffNoErr..iffReadWriteFailed] OF String =
  510.                         ("Kein Fehler",
  511.                          "Nicht genug Speicher!",
  512.                          "Fehler bei Openscreen!",
  513.                          "Fehler bei Openwindow!",
  514.                          "Konnte Datei nicht öffnen!",
  515.                          "Fahlsches IFF-Format!",
  516.                          "Schreib-/Lese-Fehler!");
  517.  
  518.  
  519. FUNCTION ReadILBM(    name     : String;
  520.                   VAR myscreen : ScreenPtr;
  521.                   VAR mywindow : WindowPtr) : BYTE;
  522.  
  523.   VAR IFFInfo        : IFFInfoType;
  524.       IFFError       : BYTE;
  525.       Compression,
  526.       MaskPlane,
  527.       contload       : BOOLEAN;
  528.       LineLength,
  529.       LineWidth,
  530.       i,j,k,length,
  531.       PictureLength  : INTEGER;
  532.       PictureBuffer,
  533.       WorkBuffer,
  534.       HeaderBuffer   : ADDRESS;
  535.       TextBuffer     : STRING;
  536.       LONGBuffer     : ^ARRAY [0..63] OF INTEGER;
  537.       SHORTBuffer    : ^ARRAY [0..127] OF SHORT;
  538.       BYTEBuffer     : ^ARRAY [0..255] OF BYTE;
  539.       IFFHandle      : FileHandle;
  540.       IFFBitMap      : BitMapPtr;
  541.  
  542.  
  543.   PROCEDURE BufSkip(VAR bufptr : Address ;bytes : INTEGER);
  544.  
  545.     BEGIN
  546.       bufptr:=Address(Integer(bufptr)+bytes);
  547.     END;
  548.  
  549.   PROCEDURE IFFOpenScreen;
  550.  
  551.     VAR nuscreen : NewScreen;
  552.         nuwindow : NewWindow;
  553.         i        : INTEGER;
  554.  
  555.     BEGIN
  556.       WITH NuScreen DO
  557.       BEGIN
  558.         width :=IFFInfo.IFFBMHD.scrnWidth;
  559.         IF width <IFFInfo.IFFBMHD.width  THEN width :=IFFInfo.IFFBMHD.width;
  560.  
  561.         height:=IFFInfo.IFFBMHD.scrnHeight;
  562.         IF height<IFFInfo.IFFBMHD.height THEN height:=IFFInfo.IFFBMHD.height;
  563.  
  564.         leftEdge:=IFFInfo.IFFBMHD.left;
  565.         topEdge :=IFFInfo.IFFBMHD.top;
  566.  
  567.         depth:=IFFInfo.IFFBMHD.depth;
  568.         viewModes:=0;
  569.         IF width >=640 THEN ViewModes:=ViewModes OR HIRES;
  570.         IF height>=400 THEN ViewModes:=ViewModes OR LACE;
  571.  
  572.         WITH IFFInfo.IFFCAMG DO
  573.           ViewModes:=ViewModes OR ViewType;
  574.  
  575.         IF ((depth=6) OR (depth=8)) AND (ViewModes=0) THEN
  576.         IF (IFFInfo.IFFCMAP.colorcnt=Hoch(2,depth-2)) THEN
  577.  
  578.         ViewModes:=HAM;
  579.  
  580.         IF ((ViewModes AND HAM)=HAM) AND
  581.            (IFFInfo.IFFCMAP.colorcnt>Hoch(2,depth-2)) THEN
  582.         IFFInfo.IFFCMAP.colorcnt:=Hoch(2,depth-2);
  583.  
  584.         detailPen:=0;
  585.         blockPen:=0;
  586.         stype:=CUSTOMSCREEN_f+SCREENQUIET_f+SCREENBEHIND_f;
  587.         font:=NIL;
  588.         defaultTitle:=NIL;
  589.         gadgets:=NIL;
  590.         customBitMap:=NIL;
  591.       END;
  592.  
  593.     myscreen:=OpenScreen(ADR(nuscreen));
  594.     IF myscreen=NIL THEN IFFError:=iffOpenScreenfailed
  595.                     ELSE
  596.        BEGIN
  597.          WITH IFFInfo.IFFCMAP DO
  598.            BEGIN
  599.              FOR i:=0 TO (colorCnt-1) DO
  600.                SetRGB4(ADR(myscreen^.SViewPort),i,red  [i] SHR 4,
  601.                                                   green[i] SHR 4,
  602.                                                   blue [i] SHR 4);
  603.            END;
  604.  
  605.          WITH nuwindow DO
  606.            BEGIN
  607.              leftEdge:=0;
  608.              topEdge:=0;
  609.              width:=IFFInfo.IFFBMHD.width;
  610.              height:=IFFInfo.IFFBMHD.height;
  611.              detailPen:=1;
  612.              blockPen:=0;
  613.              idcmpFlags:=MOUSEBUTTONS_f;
  614.              flags:=BORDERLESS+NOCAREREFRESH+RMBTRAP;
  615.              firstGadget:=NIL;
  616.              checkMark:=NIL;
  617.              title:=NIL;
  618.              screen:=myscreen;
  619.              bitMap:=NIL;
  620.              wtype:=CUSTOMSCREEN_F;
  621.            END;
  622.  
  623.          mywindow:=OpenWindow(ADR(nuwindow));
  624.          IF mywindow=NIL THEN
  625.             BEGIN
  626.               CloseScreen(myscreen);
  627.               myscreen:=NIL;
  628.               IFFError:=iffOpenWindowFailed;
  629.             END;
  630.        END;
  631.     END;
  632.  
  633.   PROCEDURE ReadQuick(mto : ADDRESS;Count : SHORT;fake : BOOLEAN);
  634.  
  635.     BEGIN
  636.       IF fake=FALSE THEN
  637.          CopyMem(WorkBuffer,mto,Count);
  638.       BufSkip(WorkBuffer,Count);
  639.     END;
  640.  
  641.   PROCEDURE ReadSlow(Destination : ADDRESS;Count : SHORT);
  642.  
  643.     VAR kk,
  644.         scrRow,
  645.         bCnt    : INTEGER;
  646.         inCode  : BYTE;
  647.         ToPtr   : ^ARRAY [0..9999] OF BYTE;
  648.         DPtr    : ^ARRAY [0..254] OF BYTE;
  649.         RQBuf   : BYTE;
  650.         j,jto   : SHORT;
  651.  
  652.     BEGIN
  653.       ToPtr:=Destination;
  654.       bCnt:=0;
  655.       WHILE bCnt<Count DO
  656.         BEGIN
  657.           DPtr:=WorkBuffer;
  658.           inCode:=DPtr^[0];
  659.           BufSkip(WorkBuffer,1);
  660.           IF inCode<128 THEN
  661.              BEGIN
  662.                CopyMem(WorkBuffer,Address(Integer(Destination)+bCnt),inCode+1);
  663.                BufSkip(WorkBuffer,inCode+1);
  664.                Inc(bCnt,inCode+1);
  665.              END
  666.             ELSE
  667.              IF inCode>128 THEN
  668.                 BEGIN
  669.                   DPtr:=WorkBuffer;
  670.                   RQBuf:=DPTr^[0];
  671.                   BufSkip(WorkBuffer,1);
  672.  
  673.                   jTo:=bCnt+256-inCode;
  674.                   FOR j:=bCnt TO jto DO
  675.                     ToPtr^[j]:=RQBuf;
  676.                   Inc(bCnt,257-inCode);
  677.                 END;
  678.         END;
  679.     END;
  680.  
  681.   PROCEDURE CheckILBM;
  682.  
  683.     BEGIN
  684.       IF StrNEq(TextBuffer,"FORM",4)=FALSE THEN
  685.          IFFError:=iffOpenFailed;
  686.  
  687.       IF (StrNEq(TextBuffer,"FORM",4)=TRUE) AND
  688.          (StrNEq(Address(Integer(TextBuffer)+8),"ILBM",4)=FALSE) THEN
  689.          IFFError:=iffWrongIFF;
  690.     END;
  691.  
  692.   PROCEDURE SetzeStartwerte;
  693.  
  694.     BEGIN
  695.       IFFInfo.IFFTitle:=IFFTitles(0);
  696.       IFFError:=iffnoErr;
  697.       myscreen:=NIL;
  698.       mywindow:=NIL;
  699.       PictureBuffer:=NIL;
  700.       PictureLength:=0;
  701.       contload:=FALSE;
  702.       IFFHandle:=NIL;
  703.     END;
  704.  
  705.   PROCEDURE ReadBMHD;
  706.  
  707.     BEGIN
  708.       IFFInfo.IFFTitle:=IFFInfo.IFFTitle OR BMHD_f;
  709.       LONGBuffer:=WorkBuffer;
  710.       BufSkip(WorkBuffer,4);
  711.       j:=LONGBuffer^[0];
  712.       SHORTBuffer:=WorkBuffer;
  713.       BYTEBuffer:=WorkBuffer;
  714.       BufSkip(WorkBuffer,j);
  715.       WITH IFFInfo.IFFBMHD DO
  716.         BEGIN
  717.           width:=SHORTBuffer^[0];
  718.           height:=SHORTBuffer^[1];
  719.           left:=SHORTBuffer^[2];
  720.           top:=SHORTBuffer^[3];
  721.           depth:=BYTEBuffer^[8];
  722.           masking:=BYTEBuffer^[9];
  723.           MaskPlane:=(masking=1);
  724.           Compression:=(ByteBuffer^[10]=1);
  725.           transCol:=SHORTBuffer^[6];
  726.           xAspect:=BYTEBuffer^[14];
  727.           yAspect:=BYTEBuffer^[15];
  728.           scrnWidth:=SHORTBuffer^[8];
  729.           scrnHeight:=SHORTBuffer^[9];
  730.         END;
  731.     END;
  732.  
  733.   PROCEDURE ReadCMAP;
  734.  
  735.     BEGIN
  736.       IFFInfo.IFFTitle:=IFFInfo.IFFTitle OR CMAP_f;
  737.       LONGBuffer:=WorkBuffer;
  738.       BufSkip(WorkBuffer,4);
  739.       i:=LONGBuffer^[0];
  740.       BYTEBuffer:=WorkBuffer;
  741.       BufSkip(WorkBuffer,i);
  742.       WITH IFFInfo.IFFCMAP DO
  743.          BEGIN
  744.           colorcnt:=i DIV 3;
  745.            j:=0;
  746.            FOR k:=0 TO colorcnt-1 DO
  747.              BEGIN
  748.                red[k]:=BYTEBuffer^[j];
  749.                green[k]:=BYTEBuffer^[j+1];
  750.                blue[k]:=BYTEBuffer^[j+2];
  751.                Inc(j,3);
  752.              END;
  753.          END;
  754.     END;
  755.  
  756.   PROCEDURE ReadCAMG;
  757.  
  758.     BEGIN
  759.       IFFInfo.IFFTitle:=IFFInfo.IFFTitle OR CAMG_f;
  760.       LONGBuffer:=WorkBuffer;
  761.       BufSkip(WorkBuffer,8);
  762.       IFFInfo.IFFCAMG.viewType:=LONGBuffer^[1];
  763.     END;
  764.  
  765.   PROCEDURE ReadBODY;
  766.  
  767.      BEGIN
  768.       IFFInfo.IFFTitle:=IFFInfo.IFFTitle OR BODY_f;
  769.  
  770.       IFFOpenScreen;
  771.  
  772.       IF IFFError=iffNoErr THEN
  773.          BEGIN
  774.            BufSkip(WorkBuffer,4);
  775.  
  776.            IFFBitMap:=myscreen^.SRastPort.BitMap;
  777.            LineLength:=RASSIZE(IFFInfo.IFFBMHD.width,1);
  778.            LineWidth:=IFFBitMap^.BytesPerRow;
  779.  
  780.            IF Compression THEN
  781.               BEGIN
  782.                 FOR i:=0 TO (IFFInfo.IFFBMHD.height-1) DO
  783.                   FOR j:=0 TO (IFFBitMap^.Depth-1) DO
  784.                     ReadSlow(Address(Integer(IFFBitMap^.Planes[j])+
  785.                             (LineWidth*i)),LineLength);
  786.               END
  787.              ELSE
  788.               BEGIN
  789.                 FOR i:=0 TO (IFFInfo.IFFBMHD.height-1) DO
  790.                   FOR j:=0 TO (IFFBitMap^.Depth-1) DO
  791.                     ReadQuick(Address(Integer(IFFBitMap^.Planes[j])+(LineWidth*i)),
  792.                 LineLength,FALSE);
  793.                 IF MaskPlane THEN
  794.                    ReadQuick(NIL,LineLength,TRUE);
  795.               END;
  796.  
  797.          END;
  798.       contload:=FALSE;
  799.     END;
  800.  
  801.   BEGIN
  802.     SetzeStartwerte;
  803.  
  804.     IFFHandle:=DOSOpen(Name,MODE_OLDFILE);            { Bilddatei öffnen   }
  805.     IF IFFHandle=NIL THEN IFFError:=iffOpenfailed     { Bei Fehler Abbruch }
  806.                      ELSE                             { sonst weiter       }
  807.       BEGIN
  808.         HeaderBuffer:=AllocMem(12,MEMF_CLEAR+MEMF_PUBLIC);{ Speicher holen }
  809.         IF HeaderBuffer<>NIL THEN
  810.           BEGIN
  811.             length:=DOSRead(IFFHandle,HeaderBuffer,12);{Die Ersten 12 Byte }
  812.             IF length<>12 THEN IFFError:=iffReadWriteFailed;       { holen }
  813.             TEXTBuffer:=HeaderBuffer;
  814.             LONGBuffer:=HeaderBuffer;
  815.             CheckILBM;                            { Überprüfen ob IFF-ILBM }
  816.  
  817.             PictureLength:=LONGBuffer^[1]-4;
  818.             FreeMem(HeaderBuffer,12);          { Speicher wieder freigeben }
  819.  
  820.             IF IFFError=iffNoErr THEN                   { Wenn kein Fehler }
  821.               BEGIN
  822.  
  823.                 PictureBuffer:=AllocMem(PictureLength,MEMF_CLEAR+MEMF_PUBLIC);
  824.                                                        { Weiterer Speicher }
  825.                 IF PictureBuffer=NIL THEN IFFError:=iffOutofmem
  826.                                      ELSE
  827.                   BEGIN
  828.                     length:=DOSRead(IFFHandle,PictureBuffer,PictureLength);
  829.                     IF IFFHandle<>NIL THEN    { Bild in den Speicher holen }
  830.                       BEGIN
  831.                         DOSClose(IFFHandle);             { Datei schließen }
  832.                         IFFHandle:=NIL;
  833.                       END;
  834.                     IF length<>PictureLength THEN IFFError:=iffReadWritefailed
  835.                                           ELSE contload:=TRUE;
  836.                     WorkBuffer:=PictureBuffer;     { Laden fertig und ende }
  837.                   END;
  838.               END;
  839.           END;
  840.       END;
  841.  
  842.     IF contload THEN
  843.       BEGIN
  844.         WHILE (IFFError=iffNoErr) AND (contload) DO { Solange kein Fehler }
  845.           BEGIN                                     { und noch Daten da   }
  846.             TextBuffer:=WorkBuffer;
  847.             BufSkip(WorkBuffer,4);
  848.  
  849.             IF StrNEq(TextBuffer,"BMHD",4) THEN
  850.                ReadBMHD;
  851.  
  852.             IF StrNEq(TextBuffer,"CMAP",4) THEN
  853.                ReadCMAP;
  854.  
  855.             IF StrNEq(TextBuffer,"CAMG",4) THEN
  856.                ReadCAMG;
  857.  
  858.             IF StrNEq(TextBuffer,"BODY",4) THEN
  859.                ReadBODY;
  860.  
  861.             IF NOT StrNEq(TextBuffer,"CMAP",4) AND
  862.                NOT StrNEq(TextBuffer,"BODY",4) AND
  863.                NOT StrNEq(TextBuffer,"CAMG",4) AND
  864.                NOT StrNEq(TextBuffer,"BMHD",4) THEN
  865.                BEGIN
  866.                  LONGBuffer:=WorkBuffer;
  867.                  BufSkip(WorkBuffer,4);
  868.                  i:=LONGBuffer^[0];
  869.                  BufSkip(WorkBuffer,i);
  870.                END;
  871.           END;
  872.       END;
  873.  
  874.     IF IFFHandle<>NIL THEN DOSClose(IFFHandle);
  875.     IF PictureBuffer<>NIL THEN FreeMem(PictureBuffer,PictureLength);
  876.     IF IFFError<>iffNoErr THEN
  877.        BEGIN
  878.          IF mywindow<>NIL THEN MyCloseWindow(mywindow);
  879.          IF myscreen<>NIL THEN CloseScreen(myscreen);
  880.          mywindow:=NIL;
  881.          myscreen:=NIL;
  882.        END
  883.       ELSE
  884.        BEGIN
  885.          ScreenToFront(MyScreen);
  886.          ActivateWindow(Mywindow);
  887.        END;
  888.  
  889.     ReadILBM:=iffError;
  890.   END;
  891.